home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
MACD 5
/
MACD 5.bin
/
workbench
/
wb
/
czesc_2
/
icontoclip
/
icontoclip.s
< prev
next >
Wrap
Text File
|
1994-04-04
|
23KB
|
1,196 lines
***************************************************
* IconToClip *
* by Douglas Nelson *
* *
* Assemble with Macro68 *
* *
* Object size = 3598 ($0E0E) bytes *
* Output file size = 4052 bytes *
* *
***************************************************
strict
default _absolute,_pcrel
exeobj
errfile ram:assem.output
objfile ram:I2C.exe
listfile ram:listfile
incpath mac:includes
incpath ram:includes
macfile alllibraryoffsets.i
macfile dos/dosextens.i
macfile exec/alerts.i
macfile exec/ports.i
macfile intuition/intuition.i
macfile libraries/iffparse.i
macfile libraries/gadtools.i
macfile workbench/workbench.i
macfile workbench/startup.i
***** startup
move.l sp,(initialSP)
move.l d0,d7 ;store dosCmdLen
movea.l (4).w,a6
move.l a6,(execbase)
* open dos
lea dosname,a1
move.l #37,d0
jsr (_LVOOpenLibrary,a6)
move.l d0,(dosbase)
bne.b gotdos
move.l #AG_OpenLib!AO_DOSLib,d7
jsr (_LVOAlert,a6)
failexit tst.l d7
bne.b fail2
bsr.b getWbMsg
bsr.b replyWbMsg
fail2 moveq #20,d0 ;FAIL
rts
exit movea.l (execbase),a6
movea.l (dosbase),a1
jsr (_LVOCloseLibrary,a6)
tst.l (WBenchMsg)
beq.b exit2
bsr.b replyWbMsg
exit2 move.l (rc),d0
movea.l (initialSP),sp
rts
* the next two subroutines here appear to allow byte branches
replyWbMsg movea.l (execbase),a6
jsr (_LVOForbid,a6)
movea.l (WBenchMsg),a1
jsr (_LVOReplyMsg,a6)
rts
getWbMsg suba.l a1,a1
jsr (_LVOFindTask,a6)
movea.l d0,a5
lea (pr_MsgPort,a5),a0
jsr (_LVOWaitPort,a6)
lea (pr_MsgPort,a5),a0
jsr (_LVOGetMsg,a6)
move.l d0,(WBenchMsg)
rts
gotdos move.l #10,(rc) ;ERROR for early exit
tst.l d7 ;dosCmdLen
beq.b WBstart
* read command line
lea template,a0
move.l a0,d1
lea pathname,a0
move.l a0,d2
moveq #0,d3 ;no optional RdArgs
movea.l (dosbase),a6
jsr (_LVOReadArgs,a6)
move.l d0,d1
jsr (_LVOFreeArgs,a6)
bra main
WBstart
bsr.b getWbMsg
* read WBArgs
movea.l d0,a2
movea.l (sm_ArgList,a2),a2
move.l (wa_Lock,a2),d1
movea.l (dosbase),a6
jsr (_LVOCurrentDir,a6)
move.l d0,d7 ;store old dir
* open icon.library
lea iconname,a1
move.l #37,d0
movea.l (execbase),a6
jsr (_LVOOpenLibrary,a6)
move.l d0,(iconbase)
beq.b endicon
*read ToolTypes
movea.l d0,a6
movea.l (wa_Name,a2),a0
jsr (_LVOGetDiskObject,a6)
tst.l d0
beq.b closeicon
movea.l d0,a2
movea.l (do_ToolTypes,a2),a0
lea pathnamename,a1
jsr (_LVOFindToolType,a6)
tst.l d0
beq.b checkcolumn
moveq #1,d0
move.l d0,(pathname)
checkcolumn movea.l (do_ToolTypes,a2),a0
lea columnname,a1
jsr (_LVOFindToolType,a6)
tst.l d0
beq.b checkwindow
moveq #1,d0
move.l d0,(column)
checkwindow movea.l (do_ToolTypes,a2),a0
lea windowname,a1
jsr (_LVOFindToolType,a6)
tst.l d0
beq.b freediskobj
moveq #1,d0
move.l d0,(window)
freediskobj
movea.l (iconbase),a6
movea.l a2,a0
jsr (_LVOFreeDiskObject,a6)
closeicon movea.l (iconbase),a1
movea.l (execbase),a6
jsr (_LVOCloseLibrary,a6)
* restore old dir
endicon move.l d7,d1
movea.l (dosbase),a6
jsr (_LVOCurrentDir,a6)
***** main program
main movea.l (execbase),a6
lea workbenchname,a1 ;open workbench
moveq #37,d0
jsr (_LVOOpenLibrary,a6)
move.l d0,(workbenchbase)
beq cleanup
lea intuitionname,a1 ;open intuition
moveq #37,d0
jsr (_LVOOpenLibrary,a6)
move.l d0,(intuibase)
beq cleanup
lea iffparsename,a1 ;open iffparse
moveq #37,d0
jsr (_LVOOpenLibrary,a6)
move.l d0,(iffparsebase)
beq cleanup
lea gadtoolsname,a1 ;open gadtools
moveq #37,d0
jsr (_LVOOpenLibrary,a6)
move.l d0,(gadtoolsbase)
beq cleanup
lea diskfontname,a1 ;open diskfont
moveq #37,d0
jsr (_LVOOpenLibrary,a6)
move.l d0,(diskfontbase)
beq cleanup
lea graphicsname,a1 ;open gfx
moveq #37,d0
jsr (_LVOOpenLibrary,a6)
move.l d0,(gfxbase)
beq cleanup
* create our two MsgPorts
movea.l (execbase),a6
jsr (_LVOCreateMsgPort,a6)
move.l d0,(WorkbenchMP)
beq cleanup
jsr (_LVOCreateMsgPort,a6)
move.l d0,(WindowMP)
beq cleanup
* add item to Tools menu
moveq #1,d0
moveq #0,d1
lea menuname,a0
movea.l (WorkbenchMP),a1
suba.l a2,a2
movea.l (workbenchbase),a6
jsr (_LVOAddAppMenuItemA,a6)
move.l d0,(appmenuitem)
beq cleanup
* cleared all obstacles, so set return code to success
moveq #0,d0
move.l d0,(rc)
* store signal masks
movea.l (WindowMP),a0
moveq #0,d1
move.b (MP_SIGBIT,a0),d1
moveq #1,d0
lsl.l d1,d0
move.l d0,(windowsignal)
movea.l (WorkbenchMP),a0
moveq #0,d1
move.b (MP_SIGBIT,a0),d1
moveq #1,d0
lsl.l d1,d0
move.l d0,(wbsignal)
* calculate union of all signal masks
or.l (windowsignal),d0
or.l (breaksignal),d0
move.l d0,(allsignals)
* open window if user specifies
tst.l (window) ;did user ask for window?
beq.b eventloop
bsr SetupScreen
tst.l d0
beq.b nowinbeep
bsr OpenI2CWindow
tst.l d0
bne.b eventloop
nowinbeep movea.l (intuibase),a6
* moveq #0,d0 ;d0 is zero anyway
jsr (_LVODisplayBeep,a6) ;warn that window is not available
eventloop move.l (allsignals),d0
movea.l (execbase),a6
jsr (_LVOWait,a6)
move.l d0,d7 ;store signal mask
* is signal from WorkbenchMP?
move.l (wbsignal),d0
and.l d7,d0
beq.b testwindowsignal
bsr HandleAppMsg
* is signal from WindowMP?
testwindowsignal
move.l (windowsignal),d0
and.l d7,d0
beq.b testbreaksignal
bsr HandleGadget
tst.l d0
beq.b cleanup ;user selected QUIT gadget
* is signal a CTRL-C?
testbreaksignal
move.l (breaksignal),d0
and.l d7,d0
bne.b cleanup ;got BREAK signal
bra eventloop ;wait for next event
* prepare to quit
cleanup tst.l (appmenuitem)
beq closewindow
* clear pending AppMsgs
clearappmsg movea.l (WorkbenchMP),a0
movea.l (execbase),a6
jsr (_LVOGetMsg,a6)
tst.l d0 ;did we get a message?
beq.b killappmenu
movea.l d0,a1
jsr (_LVOReplyMsg,a6)
bra.b clearappmsg
* remove Tools menu item; safe to call with NULL pointer
killappmenu movea.l (appmenuitem),a0
movea.l (workbenchbase),a6
jsr (_LVORemoveAppMenuItem,a6)
* close window if open
closewindow bsr CloseI2CWindow
bsr CloseDownScreen
* close MsgPorts
movea.l (execbase),a6
move.l (WindowMP),d0
beq.b closeWorkbenchMP
movea.l d0,a0
jsr (_LVODeleteMsgPort,a6)
closeWorkbenchMP
move.l (WorkbenchMP),d0
beq.b closelibs
movea.l d0,a0
jsr (_LVODeleteMsgPort,a6)
closelibs move.l (gfxbase),d0
beq.b closediskfont
movea.l d0,a1
jsr (_LVOCloseLibrary,a6)
closediskfont
move.l (diskfontbase),d0
beq.b closegadtools
movea.l d0,a1
jsr (_LVOCloseLibrary,a6)
closegadtools
move.l (gadtoolsbase),d0
beq.b closeiffparse
movea.l d0,a1
jsr (_LVOCloseLibrary,a6)
closeiffparse
move.l (iffparsebase),d0
beq.b closeintui
movea.l d0,a1
jsr (_LVOCloseLibrary,a6)
closeintui move.l (intuibase),d0
beq.b closeworkbench
movea.l d0,a1
jsr (_LVOCloseLibrary,a6)
closeworkbench
move.l (workbenchbase),d0
beq.b allclosed
movea.l d0,a1
jsr (_LVOCloseLibrary,a6)
allclosed
bra exit
***** subroutine HandleAppMsg
* returns NULL in d0 if anything fails
HandleAppMsg
movea.l (WorkbenchMP),a0
movea.l (execbase),a6
jsr (_LVOGetMsg,a6)
move.l d0,(appmsg)
beq endHandleAppMsg
sf (separate) ;first name, so no separator
movea.l d0,a0
move.l (am_ArgList,a0),(arglist)
move.l (am_NumArgs,a0),(numargs)
bne IconIsHilited
* user selected menu with no icons hilited, so open window
move.l (I2CWnd),d0
beq.b openwindow
* window is open so move it to front
movea.l d0,a0
movea.l (intuibase),a6
jsr (_LVOWindowToFront,a6)
bra NextAppMsg
* must call SetupScreen() each time before opening window, since sneaky user
* may have changed Workbench screen
openwindow bsr SetupScreen
tst.l d0
beq.b nowindow
bsr OpenI2CWindow
tst.l d0
bne NextAppMsg ;window opened successfully
nowindow movea.l (intuibase),a6
* moveq #0,d0 ;d0 is zero anyway
jsr (_LVODisplayBeep,a6) ;warn that window is not available
bra NextAppMsg
IconIsHilited
tst.l (column)
beq.b lineformat
move.b #$A,(separator) ;separate names with linefeed
bra.b tryInitClip
lineformat move.b #' ',(separator) ;separate names with space
tryInitClip bsr InitClip
tst.l d0
beq AbortClip
WriteIconsToClip
tst.l (numargs) ;loop while numargs>0
beq callCloseClip
tst.b (separate) ;is this first write?
beq.b writename ;if yes, no separator needed
lea separator,a0
move.l a0,d0
bsr WriteClip
tst.l d0 ;did WriteClip succeed?
beq AbortClip
writename tst.l (pathname) ;write full pathname?
beq IconNameOnly
* write full pathname
* first, get directory path
movea.l (arglist),a0
move.l (wa_Lock,a0),d1
lea dirname,a0
move.l a0,d2
move.l #256,d3
movea.l (dosbase),a6
jsr (_LVONameFromLock,a6)
tst.l d0
beq AbortClip
* add filename, if any
movea.l (arglist),a0
movea.l (wa_Name,a0),a0 ;put ptr to filename in a0
tst.b (a0) ;test if name is non-null
beq.b writepathname ;icon is volume or directory
* add filename to directory pathname
move.l a0,d2
lea dirname,a0
move.l a0,d1
move.l #256,d3
movea.l (dosbase),a6
jsr (_LVOAddPart,a6)
tst.l d0
beq AbortClip
writepathname
lea dirname,a0
move.l a0,d0
bsr WriteClip
tst.l d0
beq AbortClip
bra nextarg
* write icon name only
* first, is icon a file?
IconNameOnly
movea.l (arglist),a1
movea.l (wa_Name,a1),a0 ;put ptr to filename in a0
tst.b (a0) ;test if name is non-null
beq.b IconIsDir ;icon is volume or directory
* icon is file, so write filename
move.l a0,d0
bsr WriteClip
tst.l d0
beq AbortClip
bra nextarg
* icon is volume or directory; extract its name and write it
IconIsDir move.l (wa_Lock,a1),d1
lea dirname,a0
move.l a0,d2
move.l #256,d3
movea.l (dosbase),a6
jsr (_LVONameFromLock,a6)
tst.l d0
beq AbortClip
* get last element of pathname
lea dirname,a0
move.l a0,d1
movea.l (dosbase),a6
jsr (_LVOFilePart,a6)
move.l d0,(fileptr)
* If pathname is a volume name only, then FilePart()
* returns pointer to the null byte after the :
* To check if this is a volume, we check for the null byte
movea.l d0,a0
tst.b (a0)
bne.b WriteDirName
* icon is a volume and dirname holds its name
lea dirname,a0
move.l a0,d0
bsr WriteClip
tst.l d0
beq AbortClip
bra.b nextarg
* icon is a directory and a0 points to its name
WriteDirName
move.l a0,d0
bsr WriteClip
tst.l d0
beq AbortClip
nextarg addq.l #wa_SIZEOF,(arglist)
subq.l #1,(numargs)
st (separate) ;flag to write separator before next icon
bra WriteIconsToClip ;loop back for next icon
callCloseClip
tst.l (iff)
beq.b NextAppMsg
bsr CloseClip
NextAppMsg movea.l (appmsg),a1
movea.l (execbase),a6
jsr (_LVOReplyMsg,a6)
bra HandleAppMsg ;loop back for next appmsg
AbortClip tst.l (iff)
beq noiff
bsr CloseClip
noiff movea.l (intuibase),a6
moveq #0,d0
jsr (_LVODisplayBeep,a6) ;warn that clipboard is not available
bra NextAppMsg
endHandleAppMsg
rts
***** end HandleAppMsg
***** subroutine InitClip - opens IFF Clipboard
* returns ptr to IFFHandle in d0 if successful
InitClip movea.l (iffparsebase),a6
jsr (_LVOAllocIFF,a6)
move.l d0,(iff)
beq.b noclip
moveq #0,d0
jsr (_LVOOpenClipboard,a6)
movea.l (iff),a0
move.l d0,(iff_Stream,a0)
beq.b noclip
jsr (_LVOInitIFFasClip,a6)
movea.l (iff),a0
moveq #IFFF_WRITE,d0
jsr (_LVOOpenIFF,a6)
bne.b noclip
movea.l (iff),a0
move.l #"FTXT",d0
move.l #ID_FORM,d1
move.l #IFFSIZE_UNKNOWN,D2
jsr (_LVOPushChunk,a6)
bne.b noclip
movea.l (iff),a0
moveq #0,d0
move.l #'CHRS',d1
move.l #IFFSIZE_UNKNOWN,D2
jsr (_LVOPushChunk,a6)
bne.b noclip
move.l (iff),d0 ;return success
rts
noclip moveq #0,d0
rts
***** end InitClip
***** subroutine WriteClip - write name to Clipboard
* receives address of text buffer in d0
* returns 0 in d0 if failure
WriteClip push d0 ;save ptr to buffer
bsr.b strlen ;returns length in d0
movea.l (iff),a0
pop a1 ;load ptr to buffer
push d0 ;save string length
movea.l (iffparsebase),a6
jsr (_LVOWriteChunkBytes,a6)
cmp.l (sp)+,d0 ;was write successful?
beq.b WriteClipsuccess
moveq #0,d0 ;return failure
rts
WriteClipsuccess
moveq #1,d0
rts
***** end WriteClip
***** subroutine strlen - finds length of NULL-terminated string
* receives address of string in d0
* returns length in d0
strlen movea.l d0,a0 ;put string addr in a0
moveq #0,d0 ;clear d0
move.w #-1,d0 ;set d0.w to maximum
move.l d0,d1 ;set d1.w to maximum
.loop tst.b (a0)+ ;test for null byte
dbeq d1,.loop ;loop back if not null
sub.w d1,d0 ;calculate length
rts
***** end strlen
***** subroutine CloseClip - closes IFF Clipboard
CloseClip movea.l (iffparsebase),a6
movea.l (iff),a0
jsr (_LVOPopChunk,a6) ;pops CHRS chunk
movea.l (iff),a0
jsr (_LVOPopChunk,a6) ;pops FORM chunk
movea.l (iff),a0
jsr (_LVOCloseIFF,a6)
movea.l (iff),a0
movea.l (iff_Stream,a0),a0
jsr (_LVOCloseClipboard,a6)
movea.l (iff),a0
move.l d0,(iff_Stream,a0)
jsr (_LVOFreeIFF,a6)
rts
***** end CloseClip
***** subroutine HandleGadget - processes Gadget events
* returns 0 in d0 if user presses QUIT, else 1
HandleGadget
movea.l (WindowMP),a0
movea.l (gadtoolsbase),a6
jsr (_LVOGT_GetIMsg,a6)
move.l d0,(msg)
bne.b gotmsg
moveq #1,d0 ;non-QUIT code
rts
gotmsg movea.l d0,a1
move.l (im_Class,a1),(class)
move.w (im_Code,a1),(code)
move.l (im_IAddress,a1),(gadget)
jsr (_LVOGT_ReplyIMsg,a6)
cmpi.l #IDCMP_REFRESHWINDOW,(class)
bne.b testforgadget
movea.l (I2CWnd),a0
jsr (_LVOGT_BeginRefresh,a6)
movea.l (I2CWnd),a0
moveq #1,d0
jsr (_LVOGT_EndRefresh,a6)
bra HandleGadget
testforgadget
cmpi.l #IDCMP_GADGETUP,(class)
bne HandleGadget ;this should never happen
movea.l (gadget),a0
moveq #0,d0
move.w (gg_GadgetID,a0),d0
add.w d0,d0 ;double to get word offset
move.w (jumptable,pc,d0.w),d0
jmp (jumptable,pc,d0.w)
jumptable dw pathgadevent-jumptable
dw formatgadevent-jumptable
dw quitgadevent-jumptable
dw hidegadevent-jumptable
pathgadevent
tst.w (code)
bne.b setpathname
clr.l (pathname)
bra HandleGadget
setpathname moveq #1,d0
move.l d0,(pathname)
bra HandleGadget
formatgadevent
tst.w (code)
bne.b setcolumn
clr.l (column)
bra HandleGadget
setcolumn moveq #1,d0
move.l d0,(column)
bra HandleGadget
quitgadevent
moveq #0,d0 ;quit code
rts
hidegadevent
bsr CloseI2CWindow
bsr CloseDownScreen
bra HandleGadget
***** end HandleGadget
initialSP dl 0
rc dl 0
WBenchMsg dl 0
execbase dl 0
dosbase dl 0
workbenchbase dl 0
intuibase dl 0
iffparsebase dl 0
gadtoolsbase dl 0
diskfontbase dl 0
gfxbase dl 0
iconbase dl 0
WorkbenchMP dl 0
WindowMP dl 0
appmenuitem dl 0
windowsignal dl 0
wbsignal dl 0
breaksignal dl $1000 ;CTRL-C
allsignals dl 0
pathname dl 0 ;\
column dl 0 ;- array for ReadArgs
window dl 0 ;/
iff dl 0
template cstr "PATHNAME/S,COLUMN/S,WINDOW/S"
pathnamename
cstr 'PATHNAME'
columnname cstr 'COLUMN'
windowname cstr 'WINDOW'
even
* local vars for HandleAppMessage
appmsg dl 0
arglist dl 0
numargs dl 0
fileptr dl 0
separate db 0
separator cstr ' '
dirname dcb.b 256,0
even
* local vars for HandleGadget
msg dl 0
class dl 0
code dw 0
gadget dl 0
cstr 'By Douglas Nelson. Freely distributable.'
cstr '$VER: IconToClip 1.0 (23.1.93)'
dosname cstr "dos.library"
workbenchname cstr "workbench.library"
intuitionname cstr "intuition.library"
iffparsename cstr "iffparse.library"
gadtoolsname cstr "gadtools.library"
diskfontname cstr "diskfont.library"
graphicsname cstr "graphics.library"
iconname cstr "icon.library"
menuname cstr 'IconToClip'
even
*
* Original source machine generated by GadToolsBox V1.4
* which is (c) Copyright 1991,92 Jaba Development,
* then heavily altered to suit new assembly format,
* be shorter and clearer, and work for a window which is
* opened more than once.
*
***** subroutine SetupScreen
* returns 1 in d0 if successful
SetupScreen lea topaz8,a0
movea.l diskfontbase,a6
jsr (_LVOOpenDiskFont,a6)
move.l d0,(Font)
bne.b gotfont
rts ;failure
gotfont lea ScreenName,a0
movea.l (intuibase),a6
jsr (_LVOLockPubScreen,a6)
move.l d0,(Scr)
bne.b gotpubscreen
rts ;failure
gotpubscreen
movea.l d0,a0
movea.l #0,a1
movea.l (gadtoolsbase),a6
jsr (_LVOGetVisualInfoA,a6)
move.l d0,(VisualInfo)
bne.b gotvisinfo
rts ;failure
gotvisinfo moveq #1,d0 ;success
rts
***** end SetupScreen
***** subroutine CloseDownScreen
CloseDownScreen
move.l (VisualInfo),d0
beq.b closescreen
movea.l d0,a0
movea.l (gadtoolsbase),a6
jsr (_LVOFreeVisualInfo,a6)
move.l #0,(VisualInfo)
closescreen
move.l (Scr),d0
beq.b closefont
movea.l #0,a0
movea.l d0,a1
movea.l (intuibase),a6
jsr (_LVOUnlockPubScreen,a6)
move.l #0,(Scr)
closefont move.l (Font),d0
beq.b endCloseDownScreen
movea.l d0,a1
movea.l (gfxbase),a6
jsr (_LVOCloseFont,a6)
endCloseDownScreen
rts
***** end CloseDownScreen
***** subroutine CloseI2CWindow
CloseI2CWindow
move.l (I2CWnd),d0
beq nowindowopen
movea.l d0,a2
* save window position
move.w (wd_LeftEdge,a2),(I2CLeft)
move.w (wd_TopEdge,a2),(I2CTop)
ClearGadgetMsgs
movea.l (wd_UserPort,a2),a0
movea.l (gadtoolsbase),a6
jsr (_LVOGT_GetIMsg,a6)
tst.l d0
beq.b NoGadgetMsg
movea.l d0,a1
jsr (_LVOGT_ReplyIMsg,a6)
bra.b ClearGadgetMsgs
*end AppWindow Status
NoGadgetMsg movea.l (I2CAppWindow),a0
cmpa.l #0,a0
beq.b NoAppWindow
movea.l (workbenchbase),a6
jsr (_LVORemoveAppWindow,a6)
moveq #0,d0
move.l d0,(I2CAppWindow)
* restore original windowMP (actually NULL)
NoAppWindow movea.l (I2CWnd),a0
move.l (olduserport),(wd_UserPort,a0)
movea.l (intuibase),a6
jsr (_LVOCloseWindow,a6)
moveq #0,d0
move.l d0,(I2CWnd)
* free gadget list
nowindowopen
movea.l (I2CGList),a0
cmpa.l #0,a0
beq.b NoGList
movea.l (gadtoolsbase),a6
jsr (_LVOFreeGadgets,a6)
moveq #0,d0
move.l d0,(I2CGList)
NoGList rts
***** end CloseI2CWindow
***** subroutine CreateGadgets
* returns pointer to Gadget if successful
CreateGadgets
movea.l (Scr),a0
moveq #0,d2
move.b (sc_WBorLeft,a0),d2
move.w d2,(offx)
* offy = Scr.WBorTop + Scr.RastPort.TxHeight + 1
moveq #0,d3
lea (sc_RastPort,a0),a1 ;Screen contains RastPort
move.w (rp_TxHeight,a1),d3
addq.w #1,d3
moveq #0,d0
move.b (sc_WBorTop,a0),d0
add.w d0,d3
move.w d3,(offy)
* CreateContext
lea I2CGList,a0
movea.l (gadtoolsbase),a6
jsr (_LVOCreateContext,a6)
move.l d0,(gadlist)
beq CreateGadgetFailure
*initialize NewGadgets
moveq #3,d6
gadloop lea I2CNGads,a0
move.l d6,d1
mulu.w #gng_SIZEOF,d1
adda.l d1,a0
move.l (VisualInfo),(gng_VisualInfo,a0)
move.w (offx),d1
add.w d1,(gng_LeftEdge,a0)
move.w (offy),d1
add.w d1,(gng_TopEdge,a0)
dbra d6,gadloop
* create gadgets
movea.l (gadtoolsbase),a6
moveq #CYCLE_KIND,d0
movea.l (gadlist),a0
lea I2CNGads0,a1
lea I2CGTags0,a2
jsr (_LVOCreateGadgetA,a6)
move.l d0,(gadlist)
move.l d0,(I2CGadgets0)
moveq #CYCLE_KIND,d0
movea.l (gadlist),a0
lea I2CNGads1,a1
lea I2CGTags1,a2
jsr (_LVOCreateGadgetA,a6)
move.l d0,(gadlist)
move.l d0,(I2CGadgets1)
moveq #BUTTON_KIND,d0
movea.l (gadlist),a0
lea I2CNGads2,a1
lea I2CGTags2,a2
jsr (_LVOCreateGadgetA,a6)
move.l d0,(gadlist)
move.l d0,(I2CGadgets2)
moveq #BUTTON_KIND,d0
movea.l (gadlist),a0
lea I2CNGads3,a1
lea I2CGTags3,a2
jsr (_LVOCreateGadgetA,a6)
move.l d0,(gadlist)
move.l d0,(I2CGadgets3)
*restore offsets in tags
moveq #3,d6
restoretags lea I2CNGads,a0
move.l d6,d1
mulu.w #gng_SIZEOF,d1
adda.l d1,a0
move.w (offx),d1
sub.w d1,(gng_LeftEdge,a0)
move.w (offy),d1
sub.w d1,(gng_TopEdge,a0)
dbra d6,restoretags
tst.l (gadlist)
beq.b CreateGadgetFailure
move.l (I2CGList),d0
rts
CreateGadgetFailure
moveq #0,d0
rts
* local vars for CreateGadgets
gadlist dl 0
offx dw 0
offy dw 0 ;used in OpenI2CWindow
***** end CreateGadgets
***** subroutine OpenI2CWindow
* returns ptr to Window in d0
OpenI2CWindow
bsr CreateGadgets
tst.l d0
beq winopenfail
* set window height
moveq #104,d0
add.w (offy),d0
move.w d0,(I2CHeight)
* open window
suba.l a0,a0
lea I2CWindowTags,a1
movea.l (intuibase),a6
jsr (_LVOOpenWindowTagList,a6)
move.l d0,(I2CWnd)
beq winopenfail
* must open window with no IDCMP flags so that no userport is created;
* we want to use custom port for user port
movea.l d0,a0
move.l (wd_UserPort,a0),(olduserport) ; save UserPort
move.l (WindowMP),(wd_UserPort,a0) ; set WindowMP
move.l #CYCLEIDCMP!BUTTONIDCMP!IDCMP_REFRESHWINDOW,d0
jsr (_LVOModifyIDCMP,a6)
* add gadget list
movea.l (I2CWnd),a0
movea.l (I2CGList),a1
moveq #0,d0
move.l #-1,d1
suba.l a2,a2
jsr (_LVOAddGList,a6)
* refresh gadgets
movea.l (I2CGList),a0
movea.l (I2CWnd),a1
; a2 is still 0
jsr (_LVORefreshGadgets,a6)
* set cycle gadgets to show current setting
tst.l (pathname)
beq.b testcol
movea.l (I2CGadgets0),a0
movea.l (I2CWnd),a1
suba.l a2,a2
lea gadtags,a3
movea.l (gadtoolsbase),a6
jsr (_LVOGT_SetGadgetAttrsA,a6)
testcol tst.l (column)
beq.b refreshwindow
movea.l (I2CGadgets1),a0
movea.l (I2CWnd),a1
suba.l a2,a2
lea gadtags,a3
movea.l (gadtoolsbase),a6
jsr (_LVOGT_SetGadgetAttrsA,a6)
refreshwindow
movea.l (I2CWnd),a0
suba.l a1,a1
movea.l (gadtoolsbase),a6
jsr (_LVOGT_RefreshWindow,a6)
* set up AppWindow
moveq #0,d0
moveq #0,d1
movea.l (I2CWnd),a0
movea.l (WorkbenchMP),a1
suba.l a3,a3
movea.l (workbenchbase),a6
jsr (_LVOAddAppWindowA,a6)
move.l d0,(I2CAppWindow)
* if this fails, it is not a problem
move.l (I2CWnd),d0
rts
winopenfail moveq #0,d0
rts
GD_PathGadget EQU 0
GD_FormatGadget EQU 1
GD_QuitGadget EQU 2
GD_HideGadget EQU 3
Scr dl 0
VisualInfo dl 0
I2CWnd dl 0
I2CAppWindow dl 0
olduserport dl 0
I2CGList dl 0
Font dl 0
I2CNGads
I2CNGads0 dw 35,18,140,15
dl PathGadgetText,topaz8
dw GD_PathGadget
dl $0024,0,0
I2CNGads1 dw 35,58,140,15
dl FormatGadgetText,topaz8
dw GD_FormatGadget
dl $0024,0,0
I2CNGads2 dw 20,82,58,15
dl QuitGadgetText,topaz8
dw GD_QuitGadget
dl $0010,0,0
I2CNGads3 dw 124,82,58,15
dl HideGadgetText,topaz8
dw GD_HideGadget
dl $0010,0,0
I2CGTags
I2CGTags0 dl GTCY_Labels,PathGadgetLabels
dl $00000000
I2CGTags1 dl GTCY_Labels,FormatGadgetLabels
dl $00000000
I2CGTags2 dl $00000000
I2CGTags3 dl $00000000
PathGadgetText
cstr 'Write to Clipboard'
FormatGadgetText
cstr 'Write multiple names as'
QuitGadgetText
cstr 'Quit'
HideGadgetText
cstr 'Hide'
even
PathGadgetLabels
dl PathGadgetLab0
dl PathGadgetLab1
dl 0
FormatGadgetLabels
dl FormatGadgetLab0
dl FormatGadgetLab1
dl 0
PathGadgetLab0 cstr 'Icon name only'
PathGadgetLab1 cstr 'Full pathname'
FormatGadgetLab0 cstr 'Row'
FormatGadgetLab1 cstr 'Column'
topazFName8 cstr 'topaz.font'
even
topaz8 dl topazFName8
dw 8
db 0,0
I2CGadgets0 dl 0
I2CGadgets1 dl 0
I2CGadgets2 dl 0
I2CGadgets3 dl 0
gadtags dl GTCY_Active,1
I2CWindowTags:
I2CL dl WA_Left
dw 0 ;dummy word
I2CLeft dw 0 ;store wd_LeftEdge here for tags
I2CT dl WA_Top
dw 0 ;dummy word
I2CTop dw 12 ;store wd_TopEdge here for tags
I2CW dl WA_Width,216
I2CH dl WA_Height
dw 0
I2CHeight dw 104
dl WA_Flags,$00000006 ;Flags
dl WA_Title,I2CWTitle
dl WA_ScreenTitle,I2CSTitle
dl WA_PubScreenName,ScreenName
dl $00000000
I2CWTitle cstr 'IconToClip'
I2CSTitle cstr 'IconToClip'
ScreenName cstr 'Workbench'
end